home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / Modes / setextMode.tcl < prev    next >
Encoding:
Text File  |  2000-12-28  |  19.5 KB  |  570 lines
  1. ## -*-Tcl-*-  (nowrap)
  2.  # ==========================================================================
  3.  #  FILE: "setextMode.tcl"
  4.  #  
  5.  #  Setext file support
  6.  #
  7.  #  Recognize and automatically mark 'setext'-encoded text files, like Tidbits.
  8.  #  
  9.  #                                    created: 10/01/94 {09:51:15 pm} 
  10.  #                                last update: 12/28/2000 {09:53:09 AM} 
  11.  #  
  12.  #  Author: Craig Barton Upright
  13.  #  E-mail: <cupright@princeton.edu>
  14.  #    mail: Princeton University
  15.  #          2.N.1 Green Hall,  Princeton, New Jersey  08544
  16.  #     www: <http://www.princeton.edu/~cupright>
  17.  #  
  18.  # -------------------------------------------------------------------
  19.  #  
  20.  # Copyright (c) 2000  Tom Pollard, Craig Barton Upright
  21.  # 
  22.  # This program is free software; you can redistribute it and/or modify
  23.  # it under the terms of the GNU General Public License as published by
  24.  # the Free Software Foundation; either version 2 of the License, or
  25.  # (at your option) any later version.
  26.  # 
  27.  # This program is distributed in the hope that it will be useful,
  28.  # but WITHOUT ANY WARRANTY; without even the implied warranty of
  29.  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  30.  # GNU General Public License for more details.
  31.  # 
  32.  # You should have received a copy of the GNU General Public License
  33.  # along with this program; if not, write to the Free Software
  34.  # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  35.  # 
  36.  # ==========================================================================
  37.  ##
  38.  
  39. # ===========================================================================
  40. #
  41. # Explanation of what Setext is and does
  42. # ======================================
  43. # 
  44. # Setext stands for Structure Enhanced Text.  It is a markup scheme for
  45. # plain text documents such as email messages and e-zines.  Setext's
  46. # primary goal is to provide a way of marking text that is visually
  47. # unobtrusive, so that if you don't have a special setext browser, like
  48. # EasyView, you can still read the text.  (Have you ever tried to make
  49. # sense of HTML source without your web browswer?)
  50. # 
  51. # The document Setext Help is a description of setext concepts written by
  52. # Ian Feldman.  Setext grabbed a foothold in the Mac world with the online
  53. # publication TidBITS. Rudimentary setext browsers were built with
  54. # HyperCard for reading TidBITS. Setext seems to be merely a historical
  55. # curiousity now.
  56. # 
  57. # (NOTE: Setext is easier to use with mono-spaced fonts like Monoco.)
  58. # 
  59. #    -Donavan Hall, Tuesday, March 14, 2000
  60. # 
  61. # ------------------------------------------------------------------
  62. # 
  63. # Version 1.2   of Setx mode
  64. # ==========================
  65. # 
  66. # After Donavan sent me a Setext file for the Mode Examples folder, with an
  67. # excellent description of what Setext is (was?), I have developed a
  68. # fondness for the mode and use it exclusively for various README.TXT files
  69. # that I often write to annotate my work -- as Donavan mentions, the
  70. # marking function is quite handy.  I decided to update the mode, allowing
  71. # the user to set additional preferences, including some comment character,
  72. # magic character, keyword definition and colorizing.
  73. # 
  74. # In some ways, Setx could be thought of as "Text2", with the same
  75. # functionality, but greater customization available.  If Alpha does not
  76. # have a mode that users need, Setx could be adapted to serve as a
  77. # surrogate until they've convinced someone to write one for them.  The
  78. # current version of Setx, orginally written by Tom Pollard, is the
  79. # long-awaited 1.2 .
  80. # 
  81. # The default mode preferences are intended to show off some of Setx's new
  82. # functionality, which can be observed in the Setext Help file.
  83. # 
  84. # For more information see the Setext Help file.
  85. # 
  86. #    - Craig Barton Upright, 12 April, 2000
  87. # 
  88.  
  89. # ===========================================================================
  90. #
  91. # ◊◊◊◊ Initialization of Setx mode ◊◊◊◊ #
  92. # 
  93.  
  94. alpha::mode Setx 2.0 SetxMenu {*.stx *.etx} {
  95.     electricReturn
  96. } {
  97.     # We require 7.4b21 for prefs handling.
  98.     alpha::package require AlphaTcl 7.4b21
  99. } uninstall {
  100.     this-file
  101. } help {
  102.     file "Setext Help"
  103. } maintainer {
  104.     "Craig Barton Upright" <cupright@princeton.edu> 
  105.     <http://www.princeton.edu/~cupright/>
  106. }
  107.  
  108. proc setextMode.tcl {} {}
  109.  
  110. proc SetxMenu {} {}
  111.  
  112. namespace eval Setx {}
  113.  
  114. # ===========================================================================
  115. #
  116. # ◊◊◊◊ Setting Setx mode variables ◊◊◊◊ #
  117. #
  118. # I tried to write this mode allowing the user to make any necessary
  119. # modifications through the Mode Prefs dialog.  The commented explanations
  120. # given above each of the following preferences will appear when the user
  121. # clicks the "Help" button of the dialog.
  122. # 
  123. # Setting comment, magic character, and keyword preferences to show off
  124. # Setx's capabilities in the Setxt Help file.
  125. # 
  126.  
  127. # Removing obsolete preferences from earlier versions.
  128.  
  129. set oldvars {
  130.     don'tRemindMe
  131. }
  132.  
  133. foreach oldvar $oldvars {prefs::removeObsolete SetxmodeVars($oldvar)}
  134.  
  135. unset oldvars
  136.  
  137. #=============================================================================
  138. #
  139. # Standard preferences recognized by various Alpha procs
  140. #
  141.  
  142. newPref flag autoMark              {0}     Setx
  143. newPref var  fillColumn            {75}    Setx
  144. newPref var  wordBreak             {\w+}   Setx
  145. newPref var  wordBreakPreface      {(\W)}  Setx
  146. newPref flag wordWrap              {1}     Setx
  147.  
  148. #=============================================================================
  149. #
  150. # Flag preferences
  151. #
  152.  
  153. # Check this box to use the defined paired comment characters in Comment
  154. # Line / Box / Paragraph menu items.
  155. newPref flag usePairedComments     {0}     Setx    {Setx::updatePreferences}
  156.  
  157. #=============================================================================
  158. #
  159. # Variable preferences
  160. # 
  161.  
  162. # Everything from the Comment Character(s) to the end of the current line
  163. # will be colorized according to the "Comment Color".  This should agree
  164. # with the Prefix String below.
  165. newPref var commentCharacter      {#}     Setx    {Setx::updatePreferences}
  166.  
  167. # Select the opening character(s) of a bracketed comment. 
  168. newPref var commentPair1          {/*}    Setx    {Setx::updatePreferences}
  169.  
  170. # Select the ending character(s) of a bracketed comment.  These cannot be
  171. # the same as the opening characters.
  172. newPref var commentPair2          {*/}    Setx    {Setx::updatePreferences}
  173.  
  174. # Define the indentation string for Section marks.
  175. newPref var indentString          {   }   Setx
  176.  
  177. # Setx allows for three levels of keywords.  Shorter lists can be entered
  178. # here in the preferences.  For longer lists, see the Setext Help file for
  179. # instructions on editing a SetxPrefs.tcl file.
  180. newPref var keywords1     {setx}          Setx    {Setx::updatePreferences}
  181. newPref var keywords2     {}              Setx    {Setx::updatePreferences}
  182. newPref var keywords3     {See the Setext Help file for more information.}        Setx    {Setx::updatePreferences}
  183.  
  184. # Magic Characters will colorize any string which follows them, using the
  185. # "symbol" color.  Only one Magic Character can be defined.
  186. newPref var magicCharacter        {$}     Setx    {Setx::updatePreferences}
  187.  
  188. # Select a Prefix String for commenting lines.  This should agree with the
  189. # Comment Character above, but also have a space after the character.
  190. newPref var prefixString          {# }    Setx
  191.  
  192. # Command double-clicking will send the highlighted text to this search
  193. # engine.
  194. newPref url searchUrl1 {http://www.google.com/search?q=} Setx
  195.  
  196. # Command double-clicking while pressing the "option" key will send the
  197. # highlighted text to this search engine.
  198. newPref url searchUrl2 {http://www.go.com/Split?sv=IS&lk=noframes&qt=} Setx
  199.  
  200. # Command double-clicking while pressing the "control" key will send the
  201. # highlighted text to this search engine.
  202. newPref url searchUrl3 {http://search.metacrawler.com/crawler?general=} Setx
  203.  
  204. # Command double-clicking while pressing the "shift" key will send the
  205. # highlighted text to this search engine.
  206. newPref url searchUrl4 {http://northernlight.com/nlquery.fcg?si=&cb=0&qr=} Setx
  207.  
  208. # Additional characters to be colorized by the "Symbol Color".  The "-" and
  209. # "=" symbols will always be included.
  210. newPref var symbols               {@ %}   Setx    {Setx::updatePreferences}
  211.  
  212. # ===========================================================================
  213. #
  214. # Color preferences
  215. #
  216. # Since I want to put a message in the keyword3 box, I am setting that
  217. # color black (which will show up as "none").
  218. #
  219.  
  220. newPref color commentColor      {red}       Setx    {Setx::updatePreferences}
  221. newPref color keyword1Color     {magenta}   Setx    {Setx::updatePreferences}
  222. newPref color keyword2Color     {black}     Setx    {Setx::updatePreferences}
  223. newPref color keyword3Color     {black}     Setx    {Setx::updatePreferences}
  224.  
  225. # Color of the user defined magic character.
  226. newPref color magicColor        {blue}      Setx    {Setx::updatePreferences}
  227.  
  228. # Strings are any words that appear between double quotes on the same line.
  229. newPref color stringColor       {green}     Setx    {Setx::updatePreferences}
  230.  
  231. # This preference colorizes the = and - strings which indicate that the
  232. # line above is a heading or subheading, and any other symbols defined by
  233. # the user in "Symbols".
  234. newPref color symbolColor       {blue}      Setx    {Setx::updatePreferences}
  235.  
  236. # ===========================================================================
  237. #
  238. # Update Preferences.  
  239. # 
  240. # This allows for changes to take effect without a restart.
  241. # 
  242. # Danger:  Don't include this proc in any {mode}Prefs.tcl file !!!
  243. # 
  244. # This will source the prefs file, and thus put Alpha in an endless loop.
  245. # Instead, use a <mode>::colorize<mode> proc in the prefs file.
  246. #
  247.  
  248. proc Setx::updatePreferences    {flag} {
  249.     
  250.     global mode PREFS $flag SetxmodeVars 
  251.     
  252.     # If the mode has a {mode}Prefs.tcl file, we want to load that as 
  253.     # well, otherwise any keywords contained therein won't be updated
  254.     # without a manual "Load Prefs File".
  255.     
  256.     if {[file exists [file join ${PREFS} ${mode}Prefs.tcl]]} {
  257.         uplevel #0 [list source [file join ${PREFS} ${mode}Prefs.tcl]]
  258.     } 
  259.     
  260.     Setx::colorizeSetx
  261.     Setx::commentMenuItems
  262.     refresh
  263.     
  264.     # Alertnote notes after certain preferences have been changed.  Once a
  265.     # keyword has been identified, it cannot be "unloaded" until a restart.
  266.     
  267.     if {($flag == "keywords1")      || 
  268.         ($flag == "keywords2")      ||  
  269.         ($flag == "keywords3")      ||  
  270.         ($flag == "symbols")           } {
  271.         
  272.         alertnote "Deletions from $flag preference\
  273.           will only take effect after a restart.\
  274.           Keywords cannot be 'unloaded.'"
  275.     }
  276. }
  277.  
  278. # ===========================================================================
  279. # 
  280. # Comment Character variables for Comment Line / Paragraph / Box menu items.
  281. # 
  282.  
  283. proc Setx::commentMenuItems {} {
  284.     
  285.     global SetxmodeVars Setx::commentCharacters
  286.     
  287.     if {$SetxmodeVars(usePairedComments)} {
  288.         
  289.         # determining what the "middle comment character" is in a pair.
  290.         
  291.         if {[string length $SetxmodeVars(commentPair1)] == 2} {
  292.             set mCC [string index $SetxmodeVars(commentPair1) 1]
  293.         } else {
  294.             set mCC {*}
  295.         }
  296.         
  297.         set Setx::commentCharacters(General)           \
  298.           "$mCC"
  299.         
  300.         set Setx::commentCharacters(Paragraph)          \
  301.           [list  "$SetxmodeVars(commentPair1) "         \
  302.           " $SetxmodeVars(commentPair2)"                \
  303.           " $mCC "]
  304.         
  305.         set Setx::commentCharacters(Box)                \
  306.           [list  "$SetxmodeVars(commentPair1)" 1        \
  307.           "$SetxmodeVars(commentPair2)" 1               \
  308.           "$mCC" 3]
  309.         
  310.    } else {
  311.        set cC $SetxmodeVars(commentCharacter)
  312.         set Setx::commentCharacters(General)            \
  313.           "$cC "
  314.           
  315.         set Setx::commentCharacters(Paragraph)          \
  316.           [list  "$cC$cC " \
  317.           " $cC$cC" \
  318.           " $cC "]
  319.           
  320.         set Setx::commentCharacters(Box)                \
  321.           [list  "$cC" 1    \
  322.           "$cC" 1           \
  323.           "$cC" 3]
  324.     }
  325. }
  326.  
  327. # Call this now.
  328.  
  329. Setx::commentMenuItems
  330.  
  331. # ===========================================================================
  332. # 
  333. # ◊◊◊◊ Colorize Setx ◊◊◊◊ #
  334. # 
  335. # 
  336. # Used in updatePreferences, and could be called in a <mode>Prefs.tcl file
  337. # 
  338.  
  339. proc Setx::colorizeSetx {} {
  340.     
  341.     global SetxmodeVars Setxcmds
  342.     
  343.     set Setxcmds [lsort [lunique [concat \
  344.       $SetxmodeVars(keywords1) \
  345.       $SetxmodeVars(keywords2) \
  346.       $SetxmodeVars(keywords3) \
  347.       ]]]
  348.         
  349.     # Keywords 1
  350.     
  351.     regModeKeywords -a                          \
  352.       -e $SetxmodeVars(commentCharacter)        \
  353.       -b $SetxmodeVars(commentPair1)            \
  354.          $SetxmodeVars(commentPair2)            \
  355.       -c $SetxmodeVars(commentColor)            \
  356.       -s $SetxmodeVars(stringColor)             \
  357.       -k $SetxmodeVars(keyword1Color)  Setx     \
  358.       $SetxmodeVars(keywords1)
  359.         
  360.     # Keywords 2
  361.     
  362.     regModeKeywords -a                          \
  363.       -k $SetxmodeVars(keyword2Color)  Setx     \
  364.       $SetxmodeVars(keywords2) 
  365.     
  366.     # Keywords 3
  367.         
  368.     regModeKeywords -a                          \
  369.       -k $SetxmodeVars(keyword3Color)  Setx     \
  370.       $SetxmodeVars(keywords3)
  371.         
  372.     # Symbols, Magic Character
  373.     
  374.     regModeKeywords -a                          \
  375.       -m $SetxmodeVars(magicCharacter)          \
  376.       -k $SetxmodeVars(magicColor)  Setx        \
  377.       $SetxmodeVars(symbols)                    \
  378.       -i "=" -i "-"                             \
  379.       -I $SetxmodeVars(symbolColor)
  380. }
  381.  
  382. # This is a "dummy" command, necessary for the above proc so that all of
  383. # the "regModeKeywords" commands in the called color procs can be "adds"
  384. # (-a).  When the mode is first invoked, this has to occur before the color
  385. # procs are called.
  386.  
  387. regModeKeywords -k {none} Setx {}
  388.  
  389. # now we finally colorize
  390.  
  391. Setx::colorizeSetx
  392.  
  393. # ===========================================================================
  394. # 
  395. # ◊◊◊◊ Key Bindings, Electrics ◊◊◊◊ #
  396. # 
  397.  
  398. Bind '-' <c> {Setx::underline -} Setx
  399. Bind '=' <c> {Setx::underline =} Setx
  400.  
  401. proc Setx::underline {symbol} {
  402.  
  403.     goto [set pos [lineStart [getPos]]]
  404.     endLineSelect
  405.  
  406.     # First convert all tabs to spaces.
  407.     tabsToSpaces
  408.     goto $pos
  409.     endLineSelect
  410.  
  411.     # Now remove any stray spaces from the end of the current line.
  412.     replaceText $pos [selEnd] [string trimright [getSelect]]
  413.     goto $pos
  414.     endLineSelect
  415.     
  416.     # Now substitute the symbol for any character, and insert a new
  417.     # line below the current one.
  418.     regsub -all {.} [getSelect] $symbol symbolLine
  419.     goto [selEnd]
  420.     insertText "\r${symbolLine}\r"
  421.     markFile
  422. }
  423.  
  424. # Setting the order of precedence for completions.
  425.  
  426. set completions(Setx) {
  427.     completion::cmd completion::electric completion::word
  428. }
  429.  
  430. # Using any defined keywords for completions
  431.  
  432. set Setxcmds [lsort [concat                                             \
  433.   $SetxmodeVars(keywords1) $SetxmodeVars(keywords2) $SetxmodeVars(keywords3)]]
  434.  
  435.  
  436. # ===========================================================================
  437. # 
  438. # ◊◊◊◊ Command Double Click ◊◊◊◊ #
  439. # 
  440. # Send the highlighted text to the defined search engine.
  441. # 
  442.  
  443. proc Setx::DblClick {from to shift option control} {
  444.     
  445.     global SetxmodeVars
  446.     
  447.     select $from $to
  448.     set command [getSelect]
  449.     regsub -all { } $command {+} commandPlus
  450.     set commandPlus [concat %22$commandPlus%22]
  451.  
  452.     # Any modifiers pressed?
  453.     if {$option && $SetxmodeVars(searchUrl2) != ""} {
  454.         message "\"$command\" sent to $SetxmodeVars(searchUrl2)"
  455.         url::execute $SetxmodeVars(searchUrl2)$commandPlus
  456.     } elseif {$control && $SetxmodeVars(searchUrl3) != ""} {
  457.         message "\"$command\" sent to $SetxmodeVars(searchUrl3)"
  458.         url::execute $SetxmodeVars(searchUrl3)$commandPlus
  459.     } elseif {$shift && $SetxmodeVars(searchUrl4) != ""} {
  460.         message "\"$command\" sent to $SetxmodeVars(searchUrl4)"
  461.         url::execute $SetxmodeVars(searchUrl4)$commandPlus
  462.     } elseif {$SetxmodeVars(searchUrl1) != ""} {
  463.         message "\"$command\" sent to $SetxmodeVars(searchUrl1)"
  464.         url::execute $SetxmodeVars(searchUrl1)$commandPlus
  465.     } else {
  466.         message "The search url preference for this modifier has not been set."
  467.     } 
  468. }
  469.  
  470. # ===========================================================================
  471. # 
  472. # ◊◊◊◊ Mark File Proc ◊◊◊◊ #
  473. # 
  474. # 
  475. # author:  Tom Pollard
  476. # 
  477. # Changes made by cbu:
  478. # 
  479. #  -- changes the sub-heading to only indent three spaces, not four
  480. #  -- strip comment character, spaces from the beginning of any mark name
  481. #  
  482. # How the Mark File works
  483. # 
  484. # Any two lines that look like this:
  485. # 
  486. # Any string of words
  487. # ===================
  488. # 
  489. # will be marked as a Chapter heading.  Any two lines that look like this:
  490. # 
  491. # Any other string of words
  492. # -------------------------
  493. # 
  494. # will be marked as a Section heading.  That's all there is to it.  
  495. # 
  496.  
  497. proc Setx::MarkFile {} {
  498.     
  499.     removeAllMarks
  500.     message "Marking File …"
  501.     global SetxmodeVars 
  502.     
  503.     set cC $SetxmodeVars(commentCharacter)
  504.     set iS $SetxmodeVars(indentString)
  505.     
  506.     set pat1 {^(-+|=+)$}
  507.     set end [maxPos]
  508.     set pos [minPos]
  509.     set count1 0
  510.     set count2 0
  511.     set l {}
  512.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $pat1 $pos} match]} {
  513.         set pos1 [lineStart [pos::math [lindex $match 0] - 1]]
  514.         set marker [string trimright [eval getText $match]]
  515.         set line [string trimright [getText $pos1 [nextLineStart $pos1]]]
  516.         if {[string length $line] == [string length $marker]} {
  517.             # Strip any leading comment characters, spaces from the mark
  518.             set line [string trimleft $line "$cC "]
  519.             if {[string range $marker 0 0] == "-"} {
  520.                 set line "$iS$line"
  521.                 incr count2
  522.             } else {
  523.                 incr count1
  524.             }
  525.             regsub {/} $line {-} line
  526.             set inds($line) $pos1
  527.             lappend sects $line
  528.         }
  529.         set pos [nextLineStart [lindex $match 1]]
  530.     }
  531.     
  532.     if {[info exists inds]} {
  533.         foreach f $sects {
  534.             set next [lineStart $inds($f)]
  535.             setNamedMark $f $inds($f) $next $next
  536.         }
  537.     }
  538.     message "This file contains $count1 chapters, $count2 sections."
  539. }
  540.  
  541. # ===========================================================================
  542. #
  543. # ◊◊◊◊ Version History ◊◊◊◊ #
  544. # 
  545. #  modified by  rev    reason
  546. #  -------- --- ------ -----------
  547. #  10/01/94 tp  1.0.1  First version of Setx mode written by Tom Pollard
  548. #  04/02/00 cbu 1.0.2  Additional preferences added, allowing user to define a
  549. #                        comment character, magic character, keyword dictionaries
  550. #  04/06/00 cbu 1.1    Added "Update Colors" proc to avoid need for a restart
  551. #  04/20/00 cbu 1.1.1  Added "Use Paired Comments" variable for menu items.
  552. #                      Added "Comment Menu Items" proc to update commentCharacter sets.
  553. #  06/22/00 cbu 1.2    Reorganized Color proc routines.
  554. #                      Renamed "Update Colors" to "Update Preferences".
  555. #                      Fixed the "middle comment character" dilemna in paired 
  556. #                        comments.
  557. #                      Moved "refresh" from Colorize to Update Preferences to 
  558. #                        avoid "no open window" bug from ever coming up.
  559. #                      Mark names are stripped of leading comment characters, 
  560. #                        spaces. This way one can colorize headings using 
  561. #                        comment character.
  562. #                      Section marks indentation now a variable.
  563. #  12/04/00 cbu 1.3    Added Setx::DblClick for search urls.
  564. #  12/04/00 cbu 2.0    New url prefs handling requires 7.4b21
  565. #                      Added Bernard's bindings, Setx::underline
  566. # 
  567.  
  568. # ===========================================================================
  569. #
  570. # .